home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / tooltips.tcl.z / tooltips.tcl
Encoding:
Text File  |  1999-04-16  |  2.2 KB  |  76 lines
  1. #
  2. # tooltips version 0.1
  3. # Paul Boyer
  4. # Science Applications International Corp.
  5. #
  6. # THINGS I'D LIKE TO DO:
  7. # 1. make a widget called "tooltip_button" which does it all
  8. # and takes name and helptext as arguments in addition to all 
  9. # button args
  10. # 2. Keep visibility of tooltip always on top
  11. # 3. Must be a better way to maintain button presses than rebinding?
  12. #   Because I don't want to explicitly handle all possible bindings
  13. #   such as <Button-2> etc
  14. # 4. Allow for capability for status window at bottom of a frame
  15. #  that gets the status of the selected icon
  16.  
  17. # tkCVS note -- if you want to get rid of tooltips, then set this
  18. # variable in the tkcvs_def.tcl file, or in the ~/.tkcvs file.
  19.  
  20. # set TOOLTIPS_OFF 0
  21.  
  22. ##############################
  23. # set_tooltips gets a button's name and the tooltip string as
  24. # arguments and creates the proper bindings for entering
  25. # and leaving the button
  26.  
  27. proc set_tooltips {widget name} {
  28. global TOOLTIPS_OFF
  29.   # first, restore it's native Button 1 capability
  30.     # bind $widget <Button-1> {internal_button_press %W}
  31.     # bind $widget <ButtonRelease-1> {internal_button_release %W}
  32.     bind $widget <Enter> "internal_tooltips_PopUp %W $name %X %Y"
  33.     bind $widget <Leave> {internal_tooltips_PopDown %W}
  34. }
  35.  
  36. ##############################
  37. # internal_tooltips_PopUp is used to activate the tooltip window
  38.  
  39. proc internal_tooltips_PopUp {wid name X Y} {
  40. global TOOLTIPS_OFF
  41. global cvscfg
  42.  
  43.   if !{$TOOLTIPS_OFF} {
  44.   # get rid of other existing tooltips
  45.     catch {destroy .tooltips_wind}
  46.     toplevel .tooltips_wind
  47.  
  48.   # add a slight offset to make tooltips fall below cursor
  49.     set Y [expr $Y+15]
  50.  
  51.   # Now pop up the new widgetLabel
  52.     wm overrideredirect .tooltips_wind 1
  53.     wm geometry .tooltips_wind +${X}+${Y}
  54.     label .tooltips_wind.l -text $name -border 2 -relief raised
  55.     pack .tooltips_wind.l -in .tooltips_wind
  56.     .tooltips_wind.l configure -bg $cvscfg(tool_color)
  57.   }
  58. }
  59.  
  60. proc internal_tooltips_PopDown {widget} {
  61.     catch {destroy .tooltips_wind}
  62.     $widget configure -relief raised 
  63. }
  64.  
  65. proc internal_button_press {widget} {
  66. global TOOLTIPS_OFF
  67.     $widget configure -relief sunken
  68.     eval [lindex [$widget configure -command ] 4]
  69. }
  70.  
  71. proc internal_button_release {widget} {
  72. global TOOLTIPS_OFF
  73.     $widget configure -relief raised 
  74. }
  75.  
  76.